home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1999 July: Mac OS SDK / Dev.CD Jul 99 SDK1.toast / Development Kits / Mac OS / Communications Toolbox / CTB Sample Code 1.0b16 / CTB Sources / Sources 2 / File Transfer Tool for CTB / fscr.p < prev    next >
Encoding:
Text File  |  1989-10-06  |  6.8 KB  |  280 lines  |  [TEXT/MPS ]
  1. {************************************************************************************
  2. *
  3. *  Project Name:    FTTools
  4. *     File Name:    fscr.p
  5. *       Authors:    Rob Neville, Alex Kazim, Carol Lee, Byron Han
  6. *          Date:    May 17, 1989
  7. *
  8. *   Description:    
  9. *
  10. *************************************************************************************
  11. *
  12. *    Revision History:
  13. *        5/17/89 - Original version by Rob Neville (IIx)
  14. *        6/26/89 - Rev'd for b2 of Comm Toolbox
  15. *
  16. ************************************************************************************}
  17.  
  18.  
  19. UNIT myfscr;
  20.  
  21. INTERFACE
  22.  
  23. USES
  24.     MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf,
  25.     FixMath, Script,
  26.     FTIntf,
  27.     FileTransferTool,
  28.     FTTool,
  29.     FTUtil,
  30.     CRMIntf,
  31.     CTBUtils;
  32.  
  33. CONST    
  34.     MAX_RSRC_LEN = 256;
  35.     
  36. function fscr(hFT: FTHandle; msg: integer;p1,p2,p3: longint): longint;
  37.  
  38. IMPLEMENTATION
  39.  
  40.  
  41. function SetConfig(hFT: FTHandle; theStr:Ptr;StrResID: integer): INTEGER; FORWARD;
  42. function GetConfigStr(hFT: FTHandle; StrResID: integer): Ptr; FORWARD;
  43.  
  44.  
  45. {    **************************    }
  46. {    Entry for Script Interface    }
  47. {    **************************    }
  48.  
  49. function fscr(hFT: FTHandle;msg: integer;p1,p2,p3: longint): longint;
  50. VAR
  51.     saved : SignedByte;
  52.     
  53. begin
  54.     saved := HGetState( handle(hFT) );
  55.     hLock(handle(hFT));
  56.     case msg of
  57.         FTMgetMsg:
  58.             fscr := ord(GetConfigStr( hFT, verUS));
  59.         FTMsetMsg:
  60.             fscr := SetConfig(  hFT, Ptr(p1), verUS);
  61.     end; {case}
  62.     HSetState(handle(hFT), saved);
  63. end; {fscr}
  64.  
  65.  
  66. {    **************************************************    }
  67. {    Takes a piece of a configuration string, parses it,    }
  68. {    and sets the configuration data                        }
  69. {    **************************************************    }
  70. {    returns 0 if no error, -1 for generic errors and    }
  71. {    string index ( would be 1 base ) if the token wasn't recognized }
  72.  
  73. function SetConfig( hFT: FTHandle; theStr:Ptr;StrResID: integer): INTEGER;
  74. var
  75.     pConfig        : ConfigPtr;
  76.     i, local    : integer;
  77.     myToken        : TokenRecPtr;            {each token}
  78.     theVal        : longint;
  79.     aTokenPtr    : TokenBlockPtr;    {the whole token block}
  80.     returnVal    : longint;
  81.     tempVal,
  82.     tokeIndex,                        {string index for token strings}
  83.     valIndex    : integer;            {string index for value strings}
  84.     tokeStr        : str255;            {token as string}
  85.     procID        : integer ;        
  86.     oldattr        : integer ;    
  87.     charcount    : integer;
  88.     error        : integer ;
  89.     theToken    : tokenType;
  90.     
  91. begin
  92.     {Map to local Resource IDs}
  93.     pConfig := ConfigPtr( hFT^^.config );
  94.     procID := hFT^^.procID ;
  95.     StrResID:= CRMLocalToRealID(ClassFT,procID,'STR#',StrResID);
  96.     if  StrResID = -1 then
  97.     begin
  98.         SetConfig:= -1;
  99.         EXIT(SetConfig);                        {abort, abort}
  100.     end;
  101.     
  102.     returnVal:= InitTokenBlock(aTokenPtr) ;
  103.     if returnVal <> noErr then 
  104.     begin
  105.         SetConfig:= returnVal;
  106.         EXIT(SetConfig);                        {abort, abort}
  107.     end;
  108.     
  109.     returnVal := 1;
  110.     
  111.     aTokenPtr^.source := theStr;                {what to parse}
  112.     aTokenPtr^.sourceLength := strLen(theStr);    {just how long}
  113.     
  114.     {tokenize the string}
  115.     if IntlTokenize(aTokenPtr) <> tokenOK then 
  116.     begin        
  117.         DisposeTokenBlock(aTokenPtr);
  118.         SetConfig:= -1;
  119.         EXIT(SetConfig);
  120.     end;
  121.     
  122.     {for every token}
  123.     for i := 0 to (aTokenPtr^.tokenCount -1) do 
  124.     begin
  125.         theToken := GetSuperToken(aTokenPtr,i,tokeStr);
  126.         if theToken in WhiteTokens then
  127.             cycle
  128.         else if theToken = TokenAlpha then
  129.         begin
  130.             returnVal := 1;
  131.             
  132.             tokeIndex := MatchResString(tokeStr,1,NUMOFSTRING,StrResID);
  133.             if tokeIndex = -1 then
  134.                 leave;
  135.             if not (GetSuperToken(aTokenPtr,i,tokeStr) in WhiteTokens) then
  136.                 leave;
  137.             case tokeIndex of
  138.             
  139.                 BYRON_ID: 
  140.                     if GetSuperToken(aTokenPtr,i,tokeStr) = tokenAlpha then
  141.                     begin
  142.                         valIndex := MatchResString(tokeStr,TRUE_ID,FALSE_ID,StrResID);
  143.                         if valIndex <> -1 then
  144.                         begin
  145.                             returnVal := 0;
  146.                             if valIndex = FALSE_ID then
  147.                                 pConfig^.param1 := FALSE
  148.                             else if valIndex = TRUE_ID then
  149.                                 pConfig^.param1 := TRUE
  150.                             else
  151.                                 returnVal := 1;
  152.                         end;
  153.                     end;{ BYRON_ID}
  154.                     
  155.                 ROB_ID:
  156.                 if GetSuperToken(aTokenPtr,i,tokeStr) = tokenAlpha then
  157.                     begin
  158.                         valIndex := MatchResString(tokeStr,TRUE_ID,FALSE_ID,StrResID);
  159.                         if valIndex <> -1 then
  160.                         begin
  161.                             returnVal := 0;
  162.                             if valIndex = FALSE_ID then
  163.                                 pConfig^.param2 := FALSE
  164.                             else if valIndex = TRUE_ID then
  165.                                 pConfig^.param2 := TRUE
  166.                             else
  167.                                 returnVal := 1;
  168.                         end;
  169.                     end; { ROB_ID }
  170.                     
  171.             end; {case}
  172.             if  returnVal = 1 then
  173.                     leave ;
  174.         end {An Alpha Token}
  175.         else
  176.             leave ;        { abort on error }
  177.     end; {for every token}
  178.     if  returnVal = 1 then
  179.     begin
  180.         { get the first character position for the unrecognized token }
  181.         i := i - 1;
  182.         returnVal := 0 ;
  183.         for charcount := 1 TO i DO
  184.         begin
  185.             myToken := TokenRecPtr(ord(aTokenPtr^.tokenList) + (charcount-1)*sizeOf(TokenRec));
  186.             returnVal := returnVal + myToken^.length;
  187.         end ;
  188.         returnVal := returnVal + 1 ;        { because the string index is 1 base }
  189.     end; 
  190.     
  191.     DisposeTokenBlock(aTokenPtr);
  192.     SetConfig:= returnVal;            {g'day, mate}
  193. end; {SetConfig}
  194.  
  195.  
  196.  
  197. {    *************************************************************    }
  198. {    Reads thru the configuration data and returns a null- termiated }
  199. {    config string, returns zero if error occurs                        }
  200. {    *************************************************************    }
  201.  
  202. function GetConfigStr(hFT: FTHandle; StrResID: integer): Ptr;
  203. var
  204.     configStr    : Ptr;        {string to return}
  205.     tempPtr        : Ptr;
  206.     pConfig        : ConfigPtr;
  207.     theString    : Str255;
  208.     i            : integer;
  209.     anyErr        : integer;
  210.     valIndex    : integer;
  211.     procID        : integer;
  212.     totalLen    : longint;
  213.     notDone        : Boolean;
  214.     firstPass    : Boolean;
  215.     configHdl    : Handle;
  216.     savedConfigStr    : Ptr;
  217.  
  218. begin
  219.     procID := hFT^^.procID ;
  220.     pConfig := ConfigPtr(hFT^^.config);
  221.     notDone := TRUE;
  222.     firstPass := TRUE;
  223.     
  224.     StrResID:= CRMLocalToRealID(ClassFT,procID,'STR#',StrResID);
  225.     if StrResID = -1 then
  226.     begin
  227.         GetConfigStr := Ptr(-1 );
  228.         EXIT(GetConfigStr);
  229.     end ;
  230.     while notDone do
  231.     begin
  232.         totalLen := 0;
  233.         for i := 1 to NUMOFSTRING do
  234.         begin
  235.             GetIndString(theString,StrResID,i);
  236.             if theString[0] = chr(0) then
  237.                 leave;
  238.             totalLen := totalLen + MyCat(configStr,theString,firstPass);
  239.             case i of
  240.                 BYRON_ID:
  241.                     begin
  242.                         if pConfig^.param1 = TRUE then
  243.                             GetIndString(theString,StrResID,TRUE_ID)
  244.                         else
  245.                             GetIndString(theString,StrResID,FALSE_ID);
  246.                         totalLen := totalLen + MyCat(configStr,theString,firstPass);
  247.                     end;
  248.                 ROB_ID:
  249.                     begin
  250.                         if pConfig^.param2 = TRUE then
  251.                             GetIndString(theString,StrResID,TRUE_ID)
  252.                         else
  253.                             GetIndString(theString,StrResID,FALSE_ID);
  254.                         totalLen := totalLen + MyCat(configStr,theString,firstPass);
  255.                     end;
  256.             end; {case}
  257.         end; {for}
  258.         if firstPass then
  259.         begin
  260.             firstPass := false;
  261.             configStr := NewPtr (totalLen);
  262.             if configStr = NIL then
  263.             begin
  264.                 GetConfigStr := nil;
  265.                 EXIT(GetConfigStr);
  266.             end;
  267.             savedconfigStr := configStr;
  268.         end
  269.         else
  270.         begin
  271.             notDone := false;
  272.         end;
  273.     end; {while notdone}
  274.     
  275.     configStr := Ptr(ord4(configStr)-1);
  276.     configStr^ := 0;
  277.     GetConfigStr := savedconfigStr;
  278. end; {GetConfigStr}
  279.  
  280. END.